home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / Module source / Tool < prev    next >
Text File  |  1994-06-24  |  6KB  |  244 lines
  1. \ Construct table of names & traps for toolbox calls
  2. \ Modification History
  3. \  4/23/84  CBD Version 1.0
  4. \ 12/29/85  cdn Improved asmCall to accept upper/lower case
  5. \  6/11/86  cdn Added Mac Plus toolbox calls; generally improved code
  6. \  6/28/86  cdn Added call Pack routines by name
  7. \  7/01/86  ndc Added hash collision resolution
  8. \  8/28/86  cdn Added fcall
  9. \  9/03/86  rfd Modified Tools" for HFS compatability (no reopen)
  10. \  6/16/87    rfl    Added calls for MacII
  11. \  8/28/88    rfl increased collision table to 10 bytes because of
  12. \                confusion with dispospixmap and dispospixpat ETC.
  13. \                Make sure to vary name,trap,parm,pibx, and ctable sizes
  14. \                Also, all traps must be in one text file to be read in
  15. \ 8/31/88    rfl changed allot to reserve to fix error in modulation
  16. \                the second pass must equal the first pass in data errors
  17. \                or else the module code will figure the difference is an addr
  18. \                which must be relocated
  19. \ 9/19/88    rfl    added popupmenu traps
  20. \ 10/07/89    rfl increase to 1000 and 120
  21. \  8/13/90    rfl modify sizes
  22. \ 12/15/90    rfl    moved gtool here
  23. \  2/07/91    rfl    increased globals
  24. \  2/17/91    rfl    modified for use with Michael Hore's 32bit hash routine.
  25. \                collisions are VERY rare.
  26. \  7/02/91    rfl    allow hex values for parms
  27. \ 10/25/91    rfl    fixed occasional bug in hex value code
  28. \  3/10/94    rfl no longer print elements indeces to screen during compile
  29.  
  30. Decimal
  31.  
  32. :Module Tool
  33.  
  34. :CLASS  wArray  <Super  Object  2 <Indexed
  35.  
  36.     :M  AT:        ?idx ^Elem  w@             ;M
  37.     :M  TO:        ?idx ^Elem  w!            ;M
  38.  
  39. ;CLASS
  40.  
  41. :CLASS wordCol  <Super wArray
  42.  
  43.     Int        Size    \ # elements in list
  44.  
  45.     \ ( -- curSize )  Return #elements currently in list
  46.     :M  SIZE:  Get: Size  ;M
  47.  
  48.     \ ( val -- )   Add value to end of list
  49.     :M  ADD:  Get: Size  limit  >=
  50.         classErr" 137  Get: size  To: Self
  51.         1 +: Size   ;M
  52.  
  53.     \ ( val -- ind t  OR f)  Find a value in an OC
  54.     :M  INDEXOF:  0 swap Get: Size  0
  55.         DO i  (^elem) w@
  56.             over = IF 2drop  i 1 1 leave THEN
  57.         LOOP  drop  ;M
  58.  
  59. ;CLASS
  60.  
  61. 1500 ordered-Col Names
  62. 1500 wordCol Traps
  63. 500  wordCol pIdx
  64. 500  wordCol Parms
  65.  
  66. hex
  67. \ ( addr -- hashVal )  hash a  name into a 32-bit word
  68. create HashName 
  69.     2057    w,    \        move.l    (sp),a0
  70.     d1cb    w,    \        adda.l    a3,a0
  71.     7000    w,    \        moveq    #0,d0        \ Result will go to D0
  72.     7400    w,    \        moveq    #0,d2
  73.     1418    w,    \        move.b    (a0)+,d2    \ Count
  74.     c43c007f ,    \        and.b    #127,d2        \ Clear top bit in case it's a name field
  75.     60000008 ,    \        bra        lptest
  76.     ef98    w,    \ loop    rol.l    #7,d0
  77.     1218    w,    \        move.b    (a0)+,d1
  78.     b300    w,    \        eor.b    d1,d0        \ b300
  79.     51cafff8 ,    \ lptest dbra    d2,loop
  80.     08c0001f ,    \        bset    #31,d0
  81.     2e80    w,    \        move.l    d0,(sp)
  82. next,
  83. decimal
  84.  
  85. ( str255 chr -- offs t OR f )
  86. : charOf { adr chr -- }
  87.     0    \ bool
  88.     adr c@ 1+ 1
  89.     DO
  90.         adr i+ c@ chr = IF drop i 1- 1 leave THEN
  91.     LOOP
  92. ;
  93. 0 value pstr
  94. \ ( -- )   Get next word, add if tool name, record parm if applicable
  95. : ToolName { \ addr trap# nhash  -- } 
  96.     0 -> pstr \ size: traps .d
  97.     @word hex number drop -> trap#
  98.     @word -> addr
  99.     addr ascii , charOf         \ ignore any "," in the name
  100.     IF dup addr + 1+ -> pStr addr c! THEN
  101.     addr HashName -> nhash
  102.     nhash indexOf: names        ( trap# hashval [idx] bool )
  103.     IF   . abort" collison"        \ mark collision item
  104.     ELSE nhash add: names trap# add: traps
  105.     THEN 
  106.     pstr
  107.     IF size: names    1- add: pIdx                    \ now figure parms
  108.         pstr 1+ c@ ascii $ =
  109.         IF pstr 1+ hex ELSE pstr decimal THEN  number drop add: parms decimal
  110.     THEN ;
  111.  
  112.  
  113. \ read toolbox name/trap table and fill arrays
  114. : Tools" { \ radix cecho -- }
  115.     base -> radix  decho -> cecho
  116.     new: loadFile setName: topFile
  117.     openReadOnly: topFile ?error 149
  118.  
  119.         0 moveTo: topFile drop
  120.         query: topFile drop
  121.          BEGIN                    \ read until eof
  122.             tib c@ ascii \ <>    \ skip comments
  123.             IF  ToolName THEN
  124.             query: topFile
  125.         UNTIL
  126.         -echo
  127.  
  128.     remove: loadFile
  129.     radix -> base  cecho -> decho ;
  130.  
  131. \ load the calls into the symbol table
  132. Tools" ::Module source:calls.TOT
  133. forget ToolName    \ dump table generation code
  134.  
  135. CR
  136. size: traps  . ." routine names stored" CR
  137. size: parms . ." with parameters" CR
  138.  
  139. \ ( str255 -- Trap [parm] bool )  Get Trap word for a call index
  140. : @Trap { tStr \ mStr -- } 0 -> mStr
  141.     tStr ascii , charOf                    \ stop short of comma if any
  142.     IF dup tStr c! tStr + 2+ -> mStr THEN
  143.     tStr HashName indexOf: names 0= ?error 150
  144.     dup at: traps                    ( idx trap/flag )
  145.     mStr    \ modifier bits if any
  146.     IF    mStr 4 " REGS"    s= IF $ 0100 or THEN    \ GetTrapAddr
  147.         mStr 5 " ASYNC"    s= IF $ 0400 or THEN    \ device drivers
  148.         mStr 5 " IMMED"    s= IF $ 0200 or THEN    \ control calls
  149.         mStr 3 " SYS"    s= IF $ 0400 or THEN    \ Memory Manager
  150.         mStr 5 " CLEAR"    s= IF $ 0200 or THEN
  151.         mStr 5 " MARKS"    s= IF $ 0400 or THEN    \ String Compares
  152.         mStr 4 " CASE"    s= IF $ 0200 or THEN
  153.     THEN
  154.     swap indexOf: pIdx IF at: parms 1 ELSE 0 THEN    \ call parms if any
  155. ;
  156.  
  157. \ ( addr len -- trap )
  158. : AsmCall
  159.     str255 1+ buf255 c@ >uc
  160.     buf255 @Trap
  161.     IF $ 203c w, , THEN w, ;    \ conditionally move parm into D0
  162.  
  163. \ Trap dispatcher
  164. : Call
  165.     @word @Trap
  166.     State
  167.     IF    IF Compile wLitw w, THEN
  168.         Compile (trap) w,
  169.     ELSE IF makeInt THEN
  170.         trap
  171.     THEN
  172. ; Immediate
  173.  
  174. \ Trap dispatcher for low-level File Manager
  175. : fCall
  176.     @word @Trap
  177.     State
  178.     IF    Compile Lit
  179.         IF ELSE 0 THEN
  180.         w, w, Compile (fdos)
  181.     ELSE IF makeInt THEN
  182.         (fdos)
  183.     THEN
  184. ; Immediate
  185.  
  186.  
  187. \ ************
  188.  
  189. 182 ordered-col gNames
  190. 182 wordCol globals
  191.  
  192.  
  193. \ ( -- )   Get next word, add if global name
  194. : globalName
  195.     size: globals .d
  196.     @word hex number drop            ( global addr )
  197.     @word
  198.     HashName dup indexOf: gNames        ( trap# hashval [idx] bool )
  199.     IF   . abort" collision"        \ mark collision item
  200.     ELSE add: gNames add: globals
  201.     THEN ;
  202.  
  203. \ read toolbox name/trap table and fill arrays
  204. : Tools" { \ radix cecho -- }
  205.     base -> radix  decho -> cecho
  206.     new: loadFile setName: topFile
  207.     openReadOnly: topFile ?error 149
  208.  
  209.         0 moveTo: topFile drop
  210.         query: topFile drop
  211.          BEGIN                    \ read until eof
  212.             tib c@ ascii \ <>    \ skip comments
  213.             IF  globalName THEN 
  214.             query: topFile
  215.         UNTIL
  216.         -echo
  217.  
  218.     remove: loadFile
  219.     radix -> base  cecho -> decho ;
  220.  
  221. \ load the calls into the symbol table
  222. Tools" ::Module source:globals
  223. forget globalName    \ dump table generation code
  224.  
  225. CR
  226. size: globals  . ." routine gNames stored" CR
  227.  
  228. \ ( str255 -- global )  Get global word for a global index
  229. : @global { tStr -- }
  230.     tStr HashName indexOf: gNames 0= ?error 150
  231.     dup ^elem: globals w@                    ( idx trap/flag )
  232.     swap drop ;
  233.  
  234. \ global dispatcher
  235. : global
  236.     @word @global
  237.     state 
  238.     IF  compile lit , 'c -base ,
  239.     ELSE  -base
  240.     THEN 
  241. ; Immediate
  242.  
  243. ;Module
  244.